home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 42 / Amiga Format AFCD42 (Issue 126, Aug 1999).iso / -serious- / programming / other / wild / support / shadedresize.bas < prev    next >
BASIC Source File  |  1999-05-25  |  2KB  |  137 lines
  1. '$INCLUDE BASU:_LoadPalette.bas
  2. '$INCLUDE BASU:_DoHSL.bas
  3.  
  4. DECLARE FUNCTION FMedian(a,b,c)
  5.  
  6. SCREEN 1,320,256,8,1
  7. WINDOW 1,"Shaded resize...",,,1
  8.  
  9. pal$="EscapeLevels:BackGrounds/Various1.rgb32"
  10. CALL LoadPalette(pal$,1)
  11. CALL DoHSL
  12.  
  13. FUNCTION BestCol(RF%,GF%,BF%,ER%,EG%,EB%,RA%,RB%)
  14.  SHARED R%(),G%(),B%()
  15.  LOCAL p%,BER&,CER&,CEG&,CEB&,BC%,CE&
  16.  BER&=2^20
  17.  FOR p%=RA% TO RB%
  18.   CER&=ABS(R%(p%)-RF%)*ER%
  19.   CEG&=ABS(G%(p%)-GF%)*EG%
  20.   CEB&=ABS(B%(p%)-BF%)*EB%
  21.   CE&=CER&+CEG&+CEB&
  22.   IF CE&<BER& THEN BER&=CE&:BC%=p%
  23.  NEXT p%
  24.  BestCol=BC%
  25. END FUNCTION
  26.  
  27. tx$="EscapeLevels:BackGrounds/Foglie.txt"
  28. OPEN tx$ FOR INPUT AS 1
  29. IMAGE$=INPUT$(LOF(1),1)
  30. CLOSE 1
  31.  
  32. 'GOTO TexDRAW
  33.  
  34. DIM SHP%(255),USD%(255),RMP%(255)
  35. FOR i=0 TO 255:USD%(i)=0:NEXT i
  36.  
  37. sx=16:sy=14:x=0:y=0
  38. SHP%(0)=254
  39.  
  40. FOR i%=1 TO 254
  41.  LINE (x,y)-(x+sx,y+sy),SHP%(i%-1),bf
  42.  x=x+sx:IF x>sx*15 THEN x=0:y=y+sy
  43.  BER&=2^20
  44.  FOR j%=0 TO 255
  45.   IF j%<>i%
  46.    IF USD%(j%)=0
  47.     f%=SHP%(i%-1)
  48.     CER&=ABS(R%(j%)-R%(f%))
  49.     CEG&=ABS(G%(j%)-G%(f%))
  50.     CEB&=ABS(B%(j%)-B%(f%))
  51.     CEH&=ABS(Hue%(j%)-Hue%(f%))
  52.     CES&=ABS(Sat%(j%)-Sat%(f%))
  53.     CEL&=ABS(Lum%(j%)-Lum%(f%))
  54.     CT&=256/(CEL&+16)
  55.     HT&=(Lum%(j%)+Lum%(f%))/4
  56.     ST&=CT&
  57.     LT&=(Lum%(j%)+Lum%(f%))/32
  58.     CE&=CER&*CT&+CEG&*CT&+CEB&*CT&+CEH&*HT&+CES&*ST&+CEL&*LT&
  59.     IF CE&<BER& THEN BER&=CE&:BC%=j%
  60.    END IF
  61.   END IF
  62.  NEXT j%
  63.  SHP%(i%)=BC%
  64.  RMP%(BC%)=i%
  65.  USD%(BC%)=1
  66. NEXT i%
  67.  
  68. TEXDRAW:
  69.  
  70.  
  71. CLS
  72. a=230
  73. b=249
  74. x=0
  75. FOR i=0 TO 1 STEP 1/100
  76.  x=x+1
  77.  LINE (x,1)-(x,10),FMedian(a,b,i)
  78. NEXT i
  79. LINE (0,10)-(20,20),a,bf
  80. LINE (90,10)-(100,20),b,bf
  81.  
  82. 'END
  83.  
  84. CLS
  85. cxa=0:cya=0
  86. stx=0:sty=.2
  87. hsx=.2:hsy=0
  88. dey=100
  89.  
  90. TEXPTR&=SADD(IMAGE$)
  91.  
  92. FUNCTION Median(a,b,ko)
  93.  SHARED R%(),G%(),B%()
  94.  nR=(R%(b)-R%(a))*ko+R%(a)
  95.  nG=(R%(b)-R%(a))*ko+G%(a)
  96.  nB=(R%(b)-R%(a))*ko+B%(a)
  97.  m=BestCol(nR,nG,nB,1,1,1,0,255)
  98.  Median=m
  99. END FUNCTION
  100.  
  101. FUNCTION FMedian(a,b,ko)
  102.  SHARED SHP%(),RMP%()
  103.  FMedian=SHP%(RMP%(a)+(RMP%(b)-RMP%(a))*ko)
  104. END FUNCTION
  105.  
  106. FOR y=1 TO 100
  107.  cxl=cxa
  108.  cyl=cya
  109.  FOR x=1 TO 100
  110.   xot=cxl
  111.   yot=cyl
  112.   cxl=cxl+hsx
  113.   cyl=cyl+hsy
  114.   exx=(xot-INT(xot))
  115.   exy=(yot-INT(yot))        ' eccedenze x e y
  116.   
  117.   cob=PEEKB(TEXPTR&+INT(xot)+INT(yot)*64+1)
  118.   coex=PEEKB(TEXPTR&+INT(xot)+INT(yot)*64+2)
  119.   coey=PEEKB(TEXPTR&+INT(xot)+INT(yot)*64+1+64)
  120.     
  121.   co1=FMedian(cob,coex,exx)
  122.   co=FMedian(co1,coey,exy)
  123.   
  124.   PSET (x,y),co1
  125.   PSET (x+100,y),co
  126.   PSET (x,y+100),cob
  127.  NEXT x
  128.  cxa=cxa+stx
  129.  cya=cya+sty
  130. NEXT y
  131.  
  132.   
  133.   
  134.   
  135.   
  136.   
  137.